begin "textap"
require "{}{}" delimiters;
define #="; comment ";
define thru=" step 1 until ";
define BLKSIZE=8000, LRECL=80;
external integer !skip!;
integer indsk,outtap,outtapjfn;
string innam,lreclspaces;
integer aline;
integer array buf8[0:BLKSIZE div 4]; integer buf8ptr,buf8cnt;
string rep # reply from tty queries;
boolean looping,firsttime,rewindfirst,expungeafter,binarymode,suaimode;
boolean indexres;
string date # today;

procedure error(string e); begin
	print(13&10&e&13&10);
	intty;
	end;

procedure opentape; begin
	openf(outtap,'100000100000);
	if !skip! then error("Problems with tape open.");
	outtapjfn←cvjfn(outtap);
	mtopr(outtap,0,0) # clear errors;
	mtopr(outtap,4,4) # set industry compatible mode;
	mtopr(outtap,'20,0) # set odd parity;
	mtopr(outtap,5,BLKSIZE) # set record size bug?;
	mtopr(outtap,'24,4) # set density to 1600;
	end;

procedure outline(string ol); begin integer char;
	if length(ol)<LRECL then ol←ol&lreclspaces[1 for LRECL-length(ol)]
	else if length(ol)>LRECL then error("Internal line too long");
	while ol do idpb(lop(ol),buf8ptr);
	buf8cnt←buf8cnt+LRECL;
	if buf8cnt=BLKSIZE then begin
		buf8ptr←point(8,buf8[0],-1); buf8cnt←0;
		start!code
			protect!acs 1,2,3;
			move 1,access(outtapjfn);
			move 2,access(buf8ptr);
			movni 3,BLKSIZE;
			soutr;
			end;
		end;
	end;

procedure outsuai(string ol); begin integer len;
	len←length(ol);
	start!code
		protect!acs 1,2,3;
		move 1,access(outtapjfn);
		move 2,access(ol);
		movn 3,access(len);
		sout;
		end;
	end;

date←"                                                                       ";
start!code
	protect!acs 1,2,3;
	move 1,access(date);
	movni 2,1;
	movsi 3,'016401;
	jsys '220;
	end;
while (date[inf for 1] leq " ") and date do date←date[1 to inf-1];
if not date then error("What's the date?");
date←", as of "&date&".";

lreclspaces←" ";
while length(lreclspaces)<LRECL do lreclspaces←lreclspaces&" ";
setbreak(aline←getbreak,'12,'15,"INS");

rewindfirst←expungeafter←binarymode←suaimode←false;

rscan;
rep←intty;
if equ("TEXTAP",rep[1 to 6]) then begin
	integer i,j;
	for i←1 step 1 until 6 do j←lop(rep);
	while rep=" " do i←lop(rep);
	innam←"";
	while rep>" " do innam←innam&lop(rep);
	while true do begin string parm;
		while rep=" " do i←lop(rep);
		if not rep then done;
		parm←"";
		while rep>" " do parm←parm&lop(rep);
		if equ(parm,"rewindfirst") then rewindfirst←true
		else if equ(parm,"expungeafter") then expungeafter←true
		else if equ(parm,"binarymode") then binarymode←true
		else if equ(parm,"suaimode") then suaimode←true
		else error("Unknown paramater: "&parm);
		end;
	end
else begin
	print("From ");
	innam←intty;
	print("Rewind first? ");
	rewindfirst←(intty="y");
	print("Expunge after? ");
	expungeafter←(intty="y");
	print("Binary mode? ");
	binarymode←(intty="y");
	print("SUAI mode? ");
	suaimode←(intty="y");
	end;
indsk←openfile(innam,"RO*");
if !skip! then error("Problems with openfile.");
outtap←gtjfn("TEXTAP:",0);
if !skip! then error("Problems with TEXTAP: gtjfn.");
opentape;
if rewindfirst then mtopr(outtap,1,0) # rewind tape;

buf8ptr←point(8,buf8[0],-1); buf8cnt←0;

firsttime←true;
do begin string hdrline;
	if not firsttime then opentape;
	firsttime←false;
	print("Doing ",jfns(indsk,0),13&10);
	hdrline←"This is "&jfns(indsk,'001100000001)&" in ";
	if binarymode then begin string lin;
		hdrline←hdrline&"decimal-byte-expansion format"&date;
		outline(hdrline);
		if (LRECL div 4)*4 neq LRECL then
			error("LRECL not divisable by 4");
		lin←"";
		while true do begin integer wrd,b; string w;
			wrd←wordin(indsk);
			if !skip! then done;
			if wrd land '17 neq 0 then error("> 32 bits");
			for b←1 thru 4 do begin
				wrd←wrd rot 8;
				w←"    "&cvs(wrd land '377);
				lin←lin&w[inf-3 to inf];
				end;
			if length(lin)=LRECL then begin
				outline(lin);
				lin←"";
				end;
			end;
		outline(lin&"   -1");
		end
	else if suaimode then begin boolean looping; integer linenum;
		hdrline←hdrline&"SUAI format"&date;
		outsuai(hdrline&(13&10));
		linenum←0;
		looping←true;
		while looping do begin string lin;
			lin←input(indsk,aline);
			linenum←linenum+1;
			looping←not !skip!;
			outsuai(lin&(13&10));
			end;
		end
	else begin boolean looping; integer linenum;
		hdrline←hdrline&"text format"&date;
		outline(hdrline);
		linenum←0;
		looping←true;
		while looping do begin string lin;
			lin←input(indsk,aline);
			linenum←linenum+1;
			looping←not !skip!;
			if length(lin)>LRECL then begin
				error("Line "&cvs(linenum)&" too long.");
				lin←lin[1 to LRECL];
				end;
			outline(lin);
			end;
		end;
	if not suaimode then while buf8cnt neq 0 do outline(" ");
	closf(outtap);
	closf(indsk);
	if expungeafter then begin integer tjfn;
		tjfn←gtjfn(jfns(indsk,0),0);
		indexres←indexfile(indsk);
		delf(tjfn,'200000 lsh 18);
		end
	else indexres←indexfile(indsk);
	end until not indexres;
relbreak(aline);
release(indsk);
release(outtap);
start!code haltf; end;
end "textap";